﻿namespace FML

#light

module ListT =
 module Option = 
 
  open ListM
  open OptionM

  type IListOptionTrans = interface
    abstract Bind : 'a list option* ('a -> 'b list option) -> 'b list option
    abstract Let : 'a * ('a -> 'b list option) -> 'b list option
    abstract Return : 'a -> 'a list option
    abstract Delay : f:(unit -> 'a list option) -> 'a list option
    abstract Zero : unit -> 'a list option
    abstract Lift : 'a option -> 'a list option 
  end 
  
  type ListOptionBuilder(optionM : IOptionMonad) = class end
    with interface IListOptionTrans with
                member s.Bind(a, f) =  optionM { let! a' = a
                                                 let! b'=  optionM.MapM(f, a')
                                                 return (List.concat b')
                                               }
                member s.Let(a, f) =   f a
                member s.Return a = optionM.Return([a]);
                member s.Delay f = f()
                member s.Zero() = optionM.Zero()
                member s.Lift(a) = optionM { let! a' = a
                                             return [a'] }
  
  let listOptionT = new ListOptionBuilder(optionM) :>  IListOptionTrans
 

 module State = 
 
  open ListM
  open StateM

  type IListStateTrans = interface
    abstract Bind : a:State<'a list,'state> * f:('a -> State<'b list,'state>) -> State<'b list,'state>
    abstract Delay : f:(unit -> 'a) -> 'a
    abstract Let :  a:'a * f:('a -> State<'b list,'state>) -> State<'b list,'state>
    abstract Lift : a:State<'a,'state> -> State<'a list,'state>
    abstract Return : a:'a -> State<'a list,'state>
    abstract Get : unit -> State<'a list,'a>
    abstract Set : 'a -> State<unit list,'a>
  end

  type ListStateBuilder(stateM : IStateMonad) = class end
    with interface IListStateTrans with
                member s.Bind(a, f) =  stateM {  let! a' = a
                                                 let! b'= stateM.MapM(f, a')
                                                 return (List.concat b')
                                               }
                member s.Let(a, f) =   f a
                member s.Return a = stateM.Return([a]);
                member s.Delay f = f()
                member s.Lift(a) = stateM {  let! a' = a
                                             return [a'] }
                member s.Get() =  let lift m = (s:>IListStateTrans).Lift(m)
                                  lift StateM.get
                member s.Set(x) = let lift m = (s:>IListStateTrans).Lift(m)
                                  (lift << StateM.set) x
  
  let listStateT = new ListStateBuilder(stateM) :>  IListStateTrans
 
 module Writer = 
 
  open ListM
  open WriterM

   
(*  let tell   s = WriterM.Writer ((), s)
  let listen m = WriterM.Writer ( let (a, s) = WriterM.run m 
                                  ((a, s), s))
  let pass   m = WriterM.Writer ( let ((a, f), s) = WriterM.run m 
                                  (a, f s))
*)

  type IListWriterTrans<'s> = interface
    abstract Bind : a:Writer<'a list,'s> * f:('a -> Writer<'b list,'s>) -> Writer<'b list,'s>
    abstract Delay : f:(unit -> 'a) -> 'a
    abstract Let :  a:'a * f:('a -> Writer<'b list,'s>) -> Writer<'b list,'s>
    abstract Lift : a:Writer<'a,'s> -> Writer<'a list,'s>
    abstract Return : a:'a -> Writer<'a list,'s>
    abstract Tell : 'a -> Writer<unit, 'a>
    abstract Listen : Writer<'a, 'b> ->  Writer<('a * 'b), 'b>
    abstract Pass :  Writer<('a * ('b -> 'c)), 'b> ->  Writer<'a, 'c>
  end

  type ListWriterBuilder<'s>(writerM : IWriterMonad<'s>) = class end
    with interface IListWriterTrans<'s> with
                member s.Bind(a, f) =  writerM { let! a' = a
                                                 let! b'= writerM.MapM(f, a')
                                                 return (List.concat b')
                                               }
                member s.Let(a, f) =   f a
                member s.Return a = writerM.Return([a]);
                member s.Delay f = f()
                member s.Lift a = writerM { let! a' = a
                                            return [a'] }
                member s.Tell a = WriterM.Writer ((), a)
                member s.Listen m = WriterM.Writer ( let (a, s) = writerM.RunM m 
                                                     ((a, s), s))
                member s.Pass m = WriterM.Writer ( let ((a, f), s) = writerM.RunM m 
                                                   (a, f s))
 

 module Reader = 
 
  open ListM
  open ReaderM

  //let local f m = ReaderM.local f m

  type IListReaderTrans = interface
    abstract Bind : a:Reader<'a list,'env> * f:('a -> Reader<'b list,'env>) -> Reader<'b list,'env>
    abstract Delay : f:(unit -> 'a) -> 'a
    abstract Let :  a:'a * f:('a -> Reader<'b list,'env>) -> Reader<'b list,'env>
    abstract Return : a:'a -> Reader<'a list,'env>
    abstract Lift : a:Reader<'a,'env> -> Reader<'a list,'env>
    abstract Ask  :  unit -> Reader<'a list,'a>
    abstract Local : ('a -> 'b) -> ( Reader<'c, 'b> ->  Reader<'c, 'a>)
  end

  type ListReaderBuilder(readerM : IReaderMonad) = class end
    with interface IListReaderTrans with
                member s.Bind(a, f) =  readerM { let! a' = a
                                                 let! b'= readerM.MapM(f, a')
                                                 return (List.concat b')
                                               }
                member s.Let(a, f) =   f a
                member s.Return a = readerM.Return([a]);
                member s.Delay f = f()
                member s.Lift(a) = readerM { let! a' = a
                                             return [a'] }
                member s.Ask() = let lift m = (s:>IListReaderTrans).Lift(m)
                                 lift (Reader<_, _>.Ask())
                member s.Local f = fun m -> Reader<_, _>.Local f m
  
  let listReaderT = new ListReaderBuilder(readerM) :>  IListReaderTrans
 



 module Error = 
 
  open ListM
  open ErrorM

  type IListErrorTrans = interface
    abstract Bind : Either<'l, 'a list> * ('a -> Either<'l, 'b list>) -> Either<'l, 'b list>
    abstract Let : 'a * ('a -> Either<'l, 'b list>) -> Either<'l, 'b list>
    abstract Return : 'a -> Either<'l, 'a list>
    abstract Delay : f:(unit -> Either<'l, 'a list>) -> Either<'l, 'a list>
    abstract Zero : unit -> Either<'l, unit>
    abstract Lift : Either<'l, 'a> ->Either<'l, 'a list>
  end 
  
  type ListErrorBuilder(errorM : IErrorMonad) = class end
    with interface IListErrorTrans with
                member s.Bind(a, f) =  errorM  { let! a' = a
                                                 let! b'=  errorM.MapM(f, a')
                                                 return (List.concat b')
                                               }
                member s.Let(a, f) =   f a
                member s.Return a = errorM.Return([a]);
                member s.Delay f = f()
                member s.Zero() = errorM.Zero()
                member s.Lift(a) = errorM  { let! a' = a
                                             return [a'] }
  
  let listErrorT = new ListErrorBuilder(errorM) :>  IListErrorTrans
 

